perm filename VAL.JM2[ESS,JMC] blob sn#019551 filedate 1973-01-10 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP VAL 
00400	 (LAMBDA(E A)
00500	  (COND ((ATOM E)
00600		 (COND ((EQ E T) T)
00700		       ((EQ E NIL) NIL)
00800		       ((NUMBERP E) E)
00900		       (T ((LAMBDA (W) (COND ((NULL W) (ERROR))
00950	(T (VAL (CDAR W) (CDR W))))) (ASSOC2 E A)))))
01000		((ATOM (CAR E))
01100		 (COND ((EQ (CAR E) (QUOTE CAR)) (CAR (VAL (CADR E) A)))
01200		       ((EQ (CAR E) (QUOTE CDR)) (CDR (VAL (CADR E) A)))
01300		       ((EQ (CAR E) (QUOTE CONS)) (CONS (VAL (CADR E) A) (VAL (CADDR E) A)))
01400		       ((EQ (CAR E) (QUOTE EQ)) (EQ (VAL (CADR E) A) (VAL (CADDR E) A)))
01500		       ((EQ (CAR E) (QUOTE ATOM)) (ATOM (VAL (CADR E) A)))
01600		       ((EQ (CAR E) (QUOTE NULL)) (NULL (VAL (CADR E) A)))
01700		       ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
01800		       ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
01900		       (T
02000			((LAMBDA(W)
02100			  (COND
02200			   ((NULL W)
02300			    ((LAMBDA (Z) (COND ((NULL Z) (ERROR)) (T (VAL (CONS (CDR Z) (CDR E)) A))))
02400			     (ASS1 (QUOTE EXPR) (CAR E))))
02500			   (T (VAL (CONS (CDR W) (CDR E)) A))))
02600			 (ASSOC (CAR E) A)))))
02700		((EQ (CAAR E) (QUOTE LAMBDA)) (VAL (CADDAR E) (PAIR (CADAR E) (CDR E) A)))
02800		(T (VAL (CONS (VAL (CAR E) A) (CDR E)) A) (COMMENT THIS CASE ADDED BY DBA ******)))) 
02900	EXPR)
03000	
03100	(DEFPROP ASSOC2 
03200	 (LAMBDA (X L) (COND ((NULL L) NIL) ((EQ X (CAAR L)) L) (T (ASSOC2 X (CDR L))))) 
03300	EXPR)
03400	
03500	(DE PAIR (U V L) (COND ((NULL U) L) (T (CONS(CONS(CAR U)(CAR V))
03600				(PAIR (CDR U) (CDR V) L)))))